home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / prtcs155.zip / FTNSORT.REX < prev    next >
OS/2 REXX Batch file  |  1994-01-14  |  8KB  |  271 lines
  1. /**/
  2. v="$VER: FTNsort Rexx Multi-FTN Extract and Sort Williamson 50.20"
  3. import_command=""
  4. /* define your AmigaDOS script here with fullpath name. This will be    */
  5. /* executed as: 'Run >NIL: Execute' import_command domain pktfile       */
  6. /* Your script key arguments should be:                                 */
  7. /*  .key domain/a,file/a                                                */
  8. /*      where domain is the FTN organization name of the file           */
  9. /*      and file is the name of the file                                */
  10. /* your script should be able to build the fullpathname                 */
  11. /* If no command is specified, CYBERCRON will asyncronously execute     */ 
  12. /* InboundMGR.rexx                                                      */
  13. /*
  14.      Some HUBS bundle mail for all ones' addresses in a single archive
  15.      If you know this is case for your HUB, then you can use this utility
  16.      to extract the packets from the archive and sort them by ftn,
  17.      moving them to the proper inbound directory.
  18.      It may also be necessary to use this, after EMSI sessions, if your 
  19.      tosser is not domain or zone aware.
  20.      Written for Guy Smith ;)
  21. */
  22. debug=0
  23. options results
  24. options failat 20
  25. signal on syntax
  26. signal on halt
  27. signal on ioerr
  28. signal on break_c
  29. signal on break_d
  30.  
  31. if ~show("L", "rexxsupport.library") then
  32.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  33.         PutLog("Couldn't access support.library !",100,10)
  34.         exit 20
  35.     end
  36. pragma("W","NULL")
  37. log=show('P','ROOFLOG')
  38. sv="v"||right(v,5)
  39. script="FTNsort"
  40. dolist=0
  41.  
  42. parse upper arg arcmail indir .
  43. if arcmail="" then do
  44.     call PutLog('No file name, exiting',10,10)
  45.     exit 0
  46. end
  47. if arcmail="LIST" then do
  48.     sortlist=indir
  49.     if ~exists(sortlist) then do
  50.         putlog(sortlist' does not exist',10,10)
  51.         exit
  52.     end
  53.     arcmail=""
  54.     indir=""
  55.     dolist=1
  56. end
  57. rpath=GetClip('REXXDIR')||"/"
  58. if (~openport('CMPORT')) then do
  59.     call PutLog('Another task has CMPORT',40,90)
  60.     if exists('RPDIR:FTNSORT') then  address "CYBERCRON" "ADD_EVENT" '* * * * * :NAME Sort Run >NIL: FTNSORT 'arcmail indir' :EXECONCE :OBEYQUEUE i'
  61.     else address "CYBERCRON" "ADD_EVENT" '* * * * * :NAME Sort :REXX 'rpath'FTNsort.rexx 'arcmail indir' :EXECONCE :OBEYQUEUE i'
  62.     exit 0
  63. end
  64. dl=GetClip('DOMAINLIST')
  65. inroot= GetCLIP('INDIR')"/"
  66. call makedir(inroot||"ftnsort")
  67. sortdir=inroot||"ftnsort/"
  68. tfile="T:FTNS-"Pragma('ID')
  69.  
  70. if debug then wspec='CON:0/10/640/100/'script sv'/WAIT/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
  71.     else wspec='CON:0/10/640/100/'script sv'/INACTIVE/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
  72. call close('STDOUT');call open('STDOUT',wspec,'w')
  73. call close('STDIN');call open('STDIN','*','R')
  74.  
  75. if dolist=0 then call sortarc()
  76. else do
  77.     call putLog('Sorting mail list' sortlist,10,10)
  78.     x=open('list',sortlist,'r') 
  79.     if x=0 then do
  80.         call PutLog('Cannot find 'sortlist,10,10)
  81.         exit
  82.     end
  83.     do while ~eof('list')
  84.         arcmail=readln('list')
  85.         if arcmail="" then iterate
  86.         if exists(arcmail) then do
  87.             indir=""
  88.             call sortarc()
  89.         end;else do
  90.             PutLog(arcmail' does not exist',10,10)
  91.         end
  92.     end
  93.     call close('list')
  94.     call delete(sortlist)
  95. end
  96. exit
  97.  
  98. sortarc:
  99.     if indir="" | indir="INDIR" then do
  100.         if index(arcmail,":")>0 | index(arcmail,"/")>0 then do
  101.             indir=get_path(arcmail)
  102.             arcmail=get_fn(arcmail)
  103.         end;else do
  104.             indir=inroot||"NONSECURE/"
  105.         end
  106.     end
  107.     else indir=addslash(indir)
  108.  
  109.     call Pragma('D',sortdir)
  110.     fnote=subword(statef(indir||arcmail),8)
  111.  
  112.     PutLog('Processing:'indir||arcmail fnote,10,10)
  113.  
  114.     if right(upper(arcmail),4)~='.PKT' then do
  115.         ispacket=0
  116.         if exists('RPDIR:X') then address COMMAND "X" indir||arcmail "*.PKT"
  117.         else address "REXX" rpath'X.rexx' indir||arcmail
  118.         if RC ~= 0 then do
  119.             PutLog('Extract of 'indir||arcmail' failed',10,10)
  120.             return
  121.         end
  122.     end;else do
  123.         ispacket=1
  124.         PutLog('Moving 'arcmail' to 'sortdir,10,10)
  125.         if ~rename(indir||arcmail,sortdir||arcmail) then do
  126.             PutLog('Move failed',10,10)
  127.             return
  128.         end
  129.     end
  130.     /* get list of packets */
  131.     pktlist=showdir(sortdir,"F")
  132.     if words(pktlist)=0 then do
  133.         PutLog('Found no packets in' sortdir,10,10)
  134.         return
  135.     end;else do
  136.         PutLog('Found mail packets in' sortdir,10,10)
  137.         err=0
  138.         /* examine each packet */
  139.         do i=1 to words(pktlist)
  140.             moveit=0
  141.             pktfile=word(pktlist,i)
  142.             pktmail=sortdir||pktfile
  143.             if word(statef(pktmail),2) ~= '0' then do
  144.                 domain=readpkt(pktmail)
  145.                 if domain = 0 then err=err+1
  146.                 else do
  147.                     destdir=addslash(inroot||domain)
  148.                     moveit=1
  149.                 end
  150.             end
  151.             if ~moveit then iterate
  152.             if ~rename(pktmail,destdir||pktfile) then do
  153.                 call PutLog('Rename of 'pktmail 'to' destdir||pktfile' failed',10,10)
  154.                 err=err+1
  155.             end;else do
  156.                 Address COMMAND "FileNote" destdir||pktfile '"'fnote'"'
  157.                 PutLog('Requesting import of 'destdir||pktfile,10,10)
  158.                 if import_command="" then do
  159.                     Address CYBERCRON 'ADD_EVENT * * * * * :REXX Ram:rexx/InboundMGR.rexx TOSSPKT 'domain pktfile' :EXECONCE :OBEYQUEUE i'
  160.                 end;else do
  161.                     Address COMMAND "Run >NIL: Execute" import_command domain pktfile
  162.                 end
  163.             end
  164.         end
  165.     end
  166.     if ispacket=0 then do
  167.         if err=0 then do
  168.             PutLog('Deleting 'indir||arcmail,10,10)
  169.             call delete(indir||arcmail)
  170.         end;else do
  171.             PutLog('Had 'err' errors, renaming 'indir||arcmail' to 'indir||arcmail||'.BAD',10,10)
  172.             call rename(indir||arcmail,indir||arcmail||'.BAD')
  173.         end
  174.     end
  175. return 0
  176.  
  177.  
  178. /* read a packet and get destination address and domain */
  179. readpkt:
  180.     packet=arg(1)
  181.     if ~open('pkt',packet,'R') then do
  182.         PutLog("Can't open "packet,10,10)
  183.         err=err+1
  184.         return 0
  185.     end
  186.     buffer=readch('pkt',58)
  187.     call close('pkt')
  188.  
  189.     ozone=getint(46)
  190.     if ozone=0 | ozone=256 then ozone=getint(34)
  191.     dzone=Getint(48)
  192.     if dzone=0 | dzone=256 then dzone=getint(36)
  193.     if ozone=0 | ozone=256 | dzone=0 | dzone=256 then do
  194.         PutLog("ERR: Can't find domain, zone undefined in "packet,10,10)
  195.         err=err+1
  196.         drop buffer packet
  197.         return 0
  198.     end
  199.  
  200.     oaddress=ozone":"getint(20)"/"getint(0)"."getint(50)
  201.     daddress=dzone":"getint(22)"/"getint(2)"."getint(52)
  202.  
  203.     PutLog('Packet 'packet' from 'oaddress' for 'daddress,10,10)
  204.  
  205.     odomain=word(dl,FIND(dl,ozone)-1)
  206.     ddomain=word(dl,FIND(dl,dzone)-1)
  207.  
  208.     PutLog('Origin Domain:'odomain', Destination Domain:'ddomain,10,10)
  209.     drop buffer packet
  210. return ddomain
  211.  
  212. getint:
  213.     return c2d('00'x || reverse(substr(buffer, arg(1)+1, 2)))
  214. getint2:
  215.     return right('00' || c2d('00'x || reverse(substr(buffer, arg(1)+1, 2))), 2)
  216.  
  217. PutLog:  procedure expose log script
  218.     if arg(3) < GetClip('STATUSLEVEL') then say arg(1)
  219.     if arg(2) > GetClip('LOGLEVEL') then return 0
  220.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  221. return 0
  222.  
  223. cleanup:
  224.     PutLog('Exiting',10,10)
  225.     if exists(tfile) then call delete(tfile)
  226. return 0
  227.  
  228.  
  229. addslash:
  230. curr=arg(1)
  231. select
  232.     when right(curr, 1)=":" then nop
  233.     when right(curr, 1)="/" then nop
  234.         otherwise curr=curr"/"
  235. end
  236. return(curr)
  237.  
  238. get_path:
  239. pos=LastPos('/',arg(1))
  240. if pos=0 then pos=LastPos(':',arg(1))
  241. return SubStr(arg(1),1,pos)
  242.  
  243. get_fn:
  244. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  245. else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  246. else return arg(1)
  247.  
  248. /*  Error handling */
  249. break_c:
  250. break_d:
  251.     call cleanup
  252.     exit 10
  253. novalue:
  254.         call template_oops "Novalue" sigl
  255. syntax:
  256.         call template_oops "Syntax(RC=" || RC || ")" sigl RC
  257. failure:
  258.         call template_oops "Failure(RC=" || RC || ")" sigl
  259. ioerr:
  260.         call template_oops "IOErr" sigl 
  261. halt:
  262.         call template_oops "Halt" sigl 
  263. template_oops: procedure
  264.         parse arg what badline code
  265.         if code ~= "" then call PutLog("ERR: Line" badline what errortext(code),10,10)
  266.             else call PutLog("ERR: Line "badline what,10,10)
  267.         call cleanup
  268.         exit(40)
  269. /**/
  270.  
  271.